SUBROUTINE SetInitialCondition &
!
(iniDB)
IMPLICIT NONE
! Arguments with intent(in):
TYPE (IniList), INTENT(IN) :: iniDB
!Local declaration:
INTEGER (KIND = short) :: i, j
REAL (KIND = float) :: scalar
!------------end of declaration------------------------------------------------
!mandatory variables
! root-zone soil saturation degree
IF (SectionIsPresent('saturation-rz', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'saturation-rz') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'saturation-rz')
CALL NewGrid (soilSatRZ, mask, scalar)
ELSE
CALL GridByIni (iniDB, soilSatRZ, section = 'saturation-rz')
END IF
ELSE !grid is mandatory: stop the program if not present
CALL Catch ('error', 'SoilBalance', &
'error in loading saturation-rz: ' , &
argument = 'section not defined in ini file' )
END IF
! transmission-zone soil saturation degree
IF (SectionIsPresent('saturation-tz', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'saturation-tz') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'saturation-tz')
CALL NewGrid (soilSatTZ, mask, scalar)
ELSE
CALL GridByIni (iniDB, soilSatTZ, section = 'saturation-tz')
END IF
ELSE !grid is mandatory: stop the program if not present
CALL Catch ('error', 'SoilBalance', &
'error in loading saturation-tz: ' , &
argument = 'section not defined in ini file' )
END IF
! allocate mean saturation map
CALL NewGrid (soilSat, mask, 0.)
!allocate and set soil moisture
CALL NewGrid (soilMoisture, mask)
CALL NewGrid (soilMoistureRZ, mask)
CALL NewGrid (soilMoistureTZ, mask)
DO j = 1, mask % jdim
DO i = 1, mask % idim
SELECT CASE ( balanceId % mat (i,j) )
CASE(LAKE) !lake cells are saturated by definition
soilSat % mat(i,j) = 1.
soilSatRZ % mat(i,j) = 1.
soilSatTZ % mat(i,j) = 1.
soilMoisture % mat(i,j) = 1.
soilMoistureRZ % mat(i,j) = 1.
soilMoistureTZ % mat(i,j) = 1.
CASE DEFAULT
soilMoistureRZ % mat(i,j) = thetar % mat(i,j) + &
soilSatRZ % mat(i,j) * &
(thetas % mat(i,j) - &
thetar % mat(i,j) )
soilMoistureTZ % mat(i,j) = thetar % mat(i,j) + &
soilSatTZ % mat(i,j) * &
(thetas % mat(i,j) - &
thetar % mat(i,j) )
END SELECT
END DO
END DO
!optional variables:
! interstorm duration
IF (SectionIsPresent('interstorm-duration', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'interstorm-duration') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'interstorm-duration')
CALL NewGrid (interstormDuration, mask, INT(scalar))
ELSE
CALL GridByIni (iniDB, interstormDuration, section = 'interstorm-duration')
END IF
ELSE !grid is optional: set to default = 0
CALL NewGrid ( interstormDuration, mask, 0 )
END IF
! precipitation status
IF (SectionIsPresent('precipitation-status', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'precipitation-status') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'precipitation-status')
CALL NewGrid (rainFlag, mask, INT(scalar))
ELSE
CALL GridByIni (iniDB, rainFlag, section = 'precipitation-status')
END IF
ELSE !grid is optional: set to default = 0
CALL NewGrid ( rainFlag, mask, 0 )
END IF
! variables for SCS-CN method
IF ( infiltrationModel == SCS_CN ) THEN
! effective soil retention capacity of SCS-CN method [mm]
IF (SectionIsPresent('soil-retention', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'soil-retention') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'soil-retention')
CALL NewGrid (sEff, mask, scalar )
ELSE
CALL GridByIni (iniDB, sEff, section = 'soil-retention')
END IF
ELSE !grid is optional: set to default = 0
CALL NewGrid ( sEff, mask, 0. )
END IF
! cumulative precipitation
IF (SectionIsPresent('cumulative-precipitation', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'cumulative-precipitation') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'cumulative-precipitation')
CALL NewGrid (cuminf, mask, scalar )
ELSE
CALL GridByIni (iniDB, cuminf, section = 'cumulative-precipitation')
END IF
ELSE !grid is optional: set to default = 0
CALL NewGrid ( cuminf, mask, 0. )
END IF
END IF
! variables for Philip and Green-Ampt methods
IF ( infiltrationModel == PHILIPEQ .OR. &
infiltrationModel == GREEN_AMPT ) THEN
! cumulative infiltration
IF (SectionIsPresent('cumulative-infiltration', iniDB)) THEN
IF (KeyIsPresent ('scalar', iniDB, 'cumulative-infiltration') ) THEN
scalar = IniReadReal ('scalar', iniDB, 'cumulative-infiltration')
CALL NewGrid (cuminf, mask, scalar )
ELSE
CALL GridByIni (iniDB, cuminf, section = 'cumulative-infiltration')
END IF
ELSE !grid is optional: set to default = 0
CALL NewGrid ( cuminf, mask, 0. )
END IF
END IF
!state variable initialization
!IF (SectionIsPresent('initial-saturation', iniDB)) THEN
!
! !cold start
! IF ( KeyIsPresent ('cold', iniDB, section = 'initial-saturation') ) THEN
! !allocate state variables
! CALL NewGrid (sEff, mask, 0.)
! CALL NewGrid (rainFlag, mask, 0)
! CALL NewGrid (interstormDuration, mask, 0)
!
! !initial saturation
! isd = IniReadReal ('cold', iniDB, section = 'initial-saturation')
!
! CALL Catch ('info', 'SoilBalance: ', &
! 'initial degree of saturation: ', &
! argument = ToString(isd))
!
! !same value for root and transmission zones
! CALL NewGrid (soilSat, mask, isd)
! CALL NewGrid (soilSatRZ, mask, isd)
! CALL NewGrid (soilSatTZ, mask, isd)
!
!
! !allocate and set soil moisture
! CALL NewGrid (soilMoisture, mask)
! CALL NewGrid (soilMoistureRZ, mask)
! CALL NewGrid (soilMoistureTZ, mask)
!
! DO i = 1, mask % idim
! DO j = 1, mask % jdim
! SELECT CASE ( balanceId % mat (i,j) )
! CASE(LAKE)
! soilSat % mat(i,j) = 1.
! soilSatRZ % mat(i,j) = 1.
! soilSatTZ % mat(i,j) = 1.
! soilMoisture % mat(i,j) = 1.
! CASE DEFAULT
! soilMoisture % mat(i,j) = thetar % mat(i,j) + &
! soilSat % mat(i,j) * &
! (thetas % mat(i,j) - &
! thetar % mat(i,j) )
!
! !lake cells are saturated by definition
!
! END SELECT
! END DO
! END DO
!
! !same initial soil mositure for root and transmission zones
! soilMoistureRZ = soilMoisture
! soilMoistureTZ = soilMoisture
!
! ELSE !hot start
! !soil moisture
! !TODO HOT START FOR ROOT AND TRANSMISSION ZONES
! CALL GridByIni (iniDB, soilMoisture, section = 'initial-saturation')
! IF ( .NOT. CRSisEqual (mask = mask, grid = soilMoisture, &
! checkCells = .TRUE.) ) THEN
! CALL Catch ('error', 'SoilBalance ', &
! 'wrong spatial reference in soil-moisture' )
! END IF
!
! !compute soil relative saturation
! CALL NewGrid (soilSat, mask)
!
! DO i = 1, mask % idim
! DO j = 1, mask % jdim
! SELECT CASE ( balanceId % mat (i,j) )
! !lake cells are saturated by definition
! CASE(LAKE)
! soilSat % mat(i,j) = 1.
! soilMoisture % mat(i,j) = thetas % mat(i,j)
! CASE DEFAULT
! soilSat % mat(i,j) = ( soilMoisture % mat(i,j) - &
! thetar % mat(i,j)) / &
! ( thetas % mat(i,j) - &
! thetar % mat(i,j) )
! END SELECT
! END DO
! END DO
!
!
! ! effective soil retention capacity of SCS-CN method [mm]
! IF (infiltrationModel == SCS_CN ) THEN
! IF (SectionIsPresent('soil-retention', iniDB)) THEN
! CALL GridByIni (iniDB, sEff, section = 'soil-retention')
! IF ( .NOT. CRSisEqual (mask = mask, grid = sEff, &
! checkCells = .TRUE.) ) THEN
! CALL Catch ('error', 'SoilBalance', &
! 'wrong spatial reference in soil retention capacity sEff' )
! END IF
! ELSE
! CALL Catch ('error', 'SoilWaterBalance: ', &
! 'missing soil-retention section in configuration file' )
! END IF
! END IF
!
!
!
! !cumulative infiltration
! IF (infiltrationModel == PHILIPEQ .OR. &
! infiltrationModel == GREEN_AMPT ) THEN
! IF (SectionIsPresent('cumulative-infiltration', iniDB)) THEN
! CALL GridByIni (iniDB, cuminf, section = 'cumulative-infiltration')
! IF ( .NOT. CRSisEqual (mask = mask, grid = cuminf, &
! checkCells = .TRUE.) ) THEN
! CALL Catch ('error', 'SoilBalance', &
! 'wrong spatial reference in cumulative infiltration' )
! END IF
! ELSE
! CALL Catch ('error', 'SoilWaterBalance: ', &
! 'missing cumulative-infiltration section in configuration file' )
! END IF
! END IF
!
!
! !precipitation status
! IF (SectionIsPresent('precipitation-status', iniDB)) THEN
! CALL GridByIni (iniDB, rainFlag, section = 'precipitation-status')
! IF ( .NOT. CRSisEqual (mask = mask, grid = rainFlag, &
! checkCells = .TRUE.) ) THEN
! CALL Catch ('error', 'SoilBalance', &
! 'wrong spatial reference in precipitation status rainFlag' )
! END IF
! ELSE
! CALL Catch ('error', 'SoilBalance: ', &
! 'missing precipitation-status section in configuration file' )
! END IF
!
!
!
! !interstorm duration
! IF (SectionIsPresent('interstorm-duration', iniDB)) THEN
! CALL GridByIni (iniDB, interstormDuration, section = 'interstorm-duration')
! IF ( .NOT. CRSisEqual (mask = mask, grid = interstormDuration, &
! checkCells = .TRUE.) ) THEN
! CALL Catch ('error', 'SoilBalance', &
! 'wrong spatial reference in interstorm duration' )
! END IF
! ELSE
! CALL Catch ('error', 'SoilBalance: ', &
! 'missing interstorm-duration section in configuration file' )
! END IF
!
! END IF !hot start
!ELSE
! CALL Catch ('error', 'SoilBalance: ', &
! 'missing initial-saturation section in configuration file' )
!END IF
RETURN
END SUBROUTINE SetInitialCondition
